home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
opbonus.arc
/
POPDOS.ARC
/
PDMAIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-03-20
|
15KB
|
475 lines
{$A-,B-,E-,F-,I-,N-,O-,R-,S-,V-}
{$I OPDEFINE.INC}
{*********************************************************}
{* PDMAIN.PAS 1.03 *}
{* Copyright (c) TurboPower Software 1990. *}
{* All rights reserved. *}
{*********************************************************}
unit PdMain;
{-Main unit for pop-to-dos TSR}
interface
uses
Dos,
OpInline,
OpString,
OpDos,
OpCrt,
{$IFDEF UseMouse}
OpMouse,
{$ENDIF}
{$IFDEF SupportXms} {!!.03}
OpXms, {!!.03}
{$ENDIF} {!!.03}
OpSwap1;
var
{Variables provide indirect access to OPEXEC unit}
ExecUseEmsIfAvailableP : ^Boolean;
ExecUseXmsIfAvailableP : ^Boolean; {!!.03}
ExecUseEmsOverXmsP : ^Boolean; {!!.03}
ExecHideSwapFileP : ^Boolean;
ExecDosSwap : function(Command : String;
UseSecond : Boolean;
EDP : Pointer;
SwapName : PathStr) : Integer;
procedure PopDosInit;
{-Install or unload POPDOS}
{=================================================================}
implementation
const
{Default options and names}
ModuleName : String[6] = 'POPDOS';
Version : String[4] = '1.03';
Hotkey : Word = $0844; {Alt F10}
HotkeyStr : String[15] = '<Alt><F10>'; {Text string for hot key}
SwapDir : String[67] = 'C:\'; {Drive and directory for swap files}
ShowSwapMsg : Boolean = True; {True to display message while TSR swaps}
ManageMouse : Boolean = True; {True to save/restore mouse state around exec}
ParasForDos : Word = $FFFF; {All available memory}
SwapName1 = '!POPDOS1.SWP'; {Swap file names, when used}
SwapName2 = '!POPDOS2.SWP';
DosSwapName = '!POPDOS3.SWP';
MinBytesForDos = 30000; {Minimum bytes to allow for shell}
type
UserDataFlags = array[1..4] of Boolean;
const
DisableFlag = 1;
ShellActiveFlag = 2;
var
ParasToKeep : Word;
OrigAttr : Byte;
{$IFDEF UseMouse}
MSP : MouseStatePtr;
MSPsize : Word;
{$ENDIF}
procedure Beep;
{-Notify of errors}
begin
Write(^G);
end;
procedure Abort(Msg : String);
{-Write message and halt}
begin
WriteLn(Msg);
Halt;
end;
{$F+}
procedure PopupEntryPoint;
{-Routine activated by hotkey}
var
Status : Integer;
SaveMode : Word;
X : Byte;
Y : Byte;
StartLine : Byte;
EndLine : Byte;
KW : Word;
Covers : Pointer;
begin
{Assure it's ok to pop to DOS right now}
ReinitCrt;
if (DosBusyFlag <> 0) or WasCommandActive or not InTextMode then begin
Beep;
Exit;
end;
{Save video state}
if not SaveWindow(1, 1, ScreenWidth, ScreenHeight, True, Covers) then begin
Beep;
Exit;
end;
SaveMode := LastMode;
WhereXYdirect(X, Y);
StartLine := CursorStartLine;
EndLine := CursorEndLine;
{Save mouse state and reinitialize mouse}
{$IFDEF UseMouse}
if MouseInstalled then begin
SaveMouseState(MSP, False);
InitializeMouse;
end;
{$ENDIF}
{Prepare the screen}
NormalCursor;
TextAttr := OrigAttr;
ClrScr;
WriteLn('Type EXIT to return to application');
{Shell to DOS}
UserDataFlags(CSSwapData^.ThisIFC.UserData)[ShellActiveFlag] := True;
Status := ExecDosSwap('', True, nil, SwapDir+DosSwapName);
UserDataFlags(CSSwapData^.ThisIFC.UserData)[ShellActiveFlag] := False;
if Status <> 0 then begin
Beep;
Write('Exec error ', Status);
KW := ReadKeyWord;
end;
{Restore the screen}
ReinitCrt;
if LastMode <> SaveMode then
TextMode(SaveMode);
RestoreWindow(1, 1, ScreenWidth, ScreenHeight, True, Covers);
SetCursorSize(StartLine, EndLine);
GoToXYAbs(X, Y);
{Restore mouse}
{$IFDEF UseMouse}
if MouseInstalled then
RestoreMouseState(MSP, False);
{$ENDIF}
end;
procedure ExternalIfc;
{-Dispatches external requests}
begin
with CSSwapData^.ThisIFC do
{Try to remove the TSR and set flag indicating success}
UserDataFlags(UserData)[DisableFlag] := DisableTSR;
end;
{$F-}
procedure TryToUnload;
{-Try to remove TSR from memory}
var
IfcP : IfcPtr;
SaveMsgOn : Boolean;
begin
{Find previous copy of TSR}
IfcP := ModulePtrByName(ModuleName);
if IfcP = nil then
Abort(ModuleName+' is not currently resident');
{Undo interrupt vectors grabbed by the transient copy of POPDOS}
RestoreAllVectors;
with IfcP^ do begin
{Disable swapping message}
CSDataPtr^.SwapMsgOn := False;
if UserDataFlags(UserData)[ShellActiveFlag] then
{Shell already active, can't disable now}
UserDataFlags(UserData)[DisableFlag] := False
else
{Tell resident copy to unload itself}
CmdEntryPtr;
{Check result and halt}
if UserDataFlags(UserData)[DisableFlag] then
Abort(ModuleName+' unloaded')
else begin
Abort('Unable to unload '+ModuleName);
CSDataPtr^.SwapMsgOn := ShowSwapMsg;
end;
end;
end;
procedure WriteHelp;
{-Write list of command line options}
begin
WriteLn;
WriteLn('Command line options:');
WriteLn(' /1 single swap file');
WriteLn(' /A visible attribute for swap files');
WriteLn(' /D force disk swapping even if EMS/XMS available');
WriteLn(' /F kbytes specify approx. kbytes free within DOS shell (default all)');
WriteLn(' /H hexkey specify TSR hot key in hex (see POPDOS.DOC)');
{$IFDEF UseMouse}
WriteLn(' /K kill mouse management code');
{$ENDIF}
WriteLn(' /M disable swap message');
WriteLn(' /S path specify drive and directory for swap files');
WriteLn(' /U unload TSR');
{$IFDEF SupportXms} {!!.03}
WriteLn(' /X use XMS memory for swap'); {!!.03}
{$ENDIF} {!!.03}
WriteLn(' /? show these command line options');
Halt;
end;
function ValidSwapPath(Path : String;
ParasToKeep : LongInt;
SingleFile : Boolean) : Boolean;
{-Return True if Path is valid and has sufficient free space}
var
E : Word;
Size : LongInt;
Drive : Char;
F : file;
begin
ValidSwapPath := False;
{Attempt to create first swap file}
Assign(F, Path+SwapName1);
Rewrite(F, 1);
E := IoResult;
case E of
0 : begin
Close(F);
E := IoResult;
end;
5 : ; {Existing file, access denied}
else
Exit;
end;
{Assure adequate disk space on swap drive}
if (Length(Path) < 2) or (Path[2] <> ':') then
Drive := DefaultDrive
else
Drive := Upcase(Path[1]);
Size := SwapSize(ParasToKeep);
if not SingleFile then
Size := Size+Size;
if DiskFree(Byte(Drive)-Byte('A')+1) >= Size then
ValidSwapPath := True;
end;
procedure ParseCommandLine;
{-Evaluate command line options}
var
I : Word;
Code : Word;
BytesForDos : LongInt;
ParasRequested : LongInt;
SingleFile : Boolean;
S : String[127];
procedure BadOption;
begin
Abort(S);
end;
begin
SingleFile := False;
I := 1;
while I <= ParamCount do begin
S := StUpcase(ParamStr(I));
if (S[1] = '/') and (Length(S) = 2) then
case S[2] of
'1' : {Single swap file}
begin
SetSingleSwapFile(True);
SingleFile := True;
end;
'A' : {Visible swap file attribute}
begin
SetSwapFileAttr(False);
ExecHideSwapFileP^ := False;
end;
'D' : {Force disk swapping}
begin
SwapUseEms := False;
ExecUseEmsIfAvailableP^ := False;
{$IFDEF SupportXms} {!!.03}
SwapUseXms := False; {!!.03}
ExecUseXmsIfAvailableP^ := False; {!!.03}
{$ENDIF} {!!.03}
end;
'F' : {Specify free kbytes in DOS shell}
if I = ParamCount then
BadOption
else begin
Inc(I);
S := StUpcase(ParamStr(I));
Val(S, BytesForDos, Code);
if Code <> 0 then
BadOption;
BytesForDos := 1024*BytesForDos;
if BytesForDos < MinBytesForDos then
BytesForDos := MinBytesForDos
else if BytesForDos > $FFFF*$10 then
BytesForDos := $FFFF*$10;
ParasForDos := BytesForDos div $10;
end;
'H' : {Set hot key (in hex)}
if I = ParamCount then
BadOption
else begin
Inc(I);
S := StUpcase(ParamStr(I));
if S[1] <> '$' then
S := '$'+S;
Val(S, Hotkey, Code);
if Code <> 0 then
BadOption;
end;
{$IFDEF UseMouse}
'K' : {Disable mouse management code}
ManageMouse := False;
{$ENDIF}
'M' : {Disable swap message}
ShowSwapMsg := False;
'S' : {Set swap path}
if I = ParamCount then
BadOption
else begin
Inc(I);
S := StUpcase(ParamStr(I));
if Length(S) > 66 then
BadOption;
SwapDir := AddBackSlash(S);
end;
'U' : {Unload TSR}
TryToUnload;
{$IFDEF SupportXms} {!!.03}
'X' : {Use XMS for swap} {!!.03}
begin {!!.03}
SwapUseXms := True; {!!.03}
EmsOverXms := False; {!!.03}
ExecUseXmsIfAvailableP^ := True; {!!.03}
ExecUseEmsOverXmsP^ := False; {!!.03}
end; {!!.03}
{$ENDIF} {!!.03}
'?' : {Show command line options}
WriteHelp;
else
BadOption;
end
else
BadOption;
Inc(I);
end;
{$IFDEF UseMouse}
if not ManageMouse then
MouseInstalled := False;
if MouseInstalled then begin
{Allocate the buffer used to save the state of the mouse}
MSPsize := MouseStateBufferSize;
{If the size is 0 or > 1000, assume that it's not safe to use the mouse}
if (MSPsize = 0) or (MSPsize > 1000) then
MouseInstalled := False
else
GetMem(MSP, MSPsize);
end;
{$ENDIF}
{Compute actual paragraphs to keep. 256 is approx size of COMMAND.COM}
ParasRequested := LongInt(ParasForDos)+CSeg-PrefixSeg+256;
if ParasRequested > MaxParagraphsToKeep then
{MaxParagraphsToKeep is all available memory}
ParasToKeep := MaxParagraphsToKeep
else if ParasRequested < ParagraphsToKeep then
{ParagraphsToKeep is the memory we've already allocated}
ParasToKeep := ParagraphsToKeep
else
ParasToKeep := ParasRequested;
{$IFDEF SupportXms} {!!.03}
if not (WillSwapUseEms(ParasToKeep) or {!!.03}
WillSwapUseXms(ParasToKeep)) then {!!.03}
{$ELSE} {!!.03}
if not WillSwapUseEms(ParasToKeep) then
{$ENDIF} {!!.03}
{Assure swap drive is valid}
if not ValidSwapPath(SwapDir, ParasToKeep, SingleFile) then
Abort('Swap file path is invalid or drive has insufficient free space');
end;
procedure PopDosInit;
{-Main routine to install POPDOS}
begin
OrigAttr := NormalAttr;
WriteLn(ModuleName, ', by TurboPower Software, Version ', Version);
if OpDos.DosVersion < $0300 then
Abort('Requires DOS version 3.00 or later');
{Get command line options}
ParseCommandLine;
{Check for previous installation}
if ModuleInstalled(ModuleName) then
Abort(ModuleName+' already installed');
{Use last line of display for swap message}
case CurrentDisplay of {!!.03}
MCGA, EGA, VGA : SetSwapMsgRow($FF); {!!.03}
end; {!!.03}
{Define hotkey, install module, set swapping message}
if not DefinePop(Hotkey, PopupEntryPoint, Ptr(SSeg, SPtr)) then
Abort('Error defining popup procedure');
InstallModule(ModuleName, ExternalIfc);
if ShowSwapMsg then
{$IFDEF SupportXms} {!!.03}
if (WillSwapUseEms(ParasToKeep) or {!!.03}
WillSwapUseXms(ParasToKeep)) and {!!.03}
(ParasToKeep div OneMs < 100) then {!!.03}
{$ELSE} {!!.03}
if WillSwapUseEms(ParasToKeep) and (ParasToKeep div OneMs < 100) then
{$ENDIF} {!!.03}
{XMS or EMS swapping will be fast enough to make swap message unneeded}
ShowSwapMsg := False;
SetSwapMsgOn(ShowSwapMsg);
{Set flag indicating shell not active}
with CSSwapData^.ThisIFC do
UserDataFlags(UserData)[ShellActiveFlag] := False;
{Go resident}
WriteLn('Going resident, ', HotkeyStr, ' to pop to DOS...');
PopupsOn;
StayResSwap(ParasToKeep, 0,
SwapDir+SwapName1, SwapDir+SwapName2,
True);
WriteLn('Error going resident');
end;
end.